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-- file: PeepholeU.mesa, edited by Sweet on Jul 11, 1978 11:58 AM 

DIRECTORY 

Code: FROM "code" USING [codeptr], 

CodeDefs: FROM "codedefs" USING [CCIndex, CCNull , ChunkBase, CodeCCIndex, CodeCCNull , JumpCCIndex] , 

ControlDefs: FROM "controldef s" USING [Fiel dDescriptor] , 

FOpCodes: FROM "fopcodes" USING [qGADRB, qLADRB. qLG, qLI, qLL, qNOOP, qRIG, qRIL, qRR], 

InlineDefs: FROM "inlinedefs" USING [BITAND, BITOR, BITSHIFT], 

Mopcodes: FROM "mopcodes" USING [zLIB, zLINl, zLINB, zLIW], 

OpCodeParams: FROM "opcodeparams" USING [BYTE, LoadlmmediateSlots, LocalHB, zLIn], 

OpTableDefs: FROM "optabledef s" USING [instal igned. instlength], 

PSADefs: FROM "pSadefs" USING [AnocCodeCCItem, deletecell, NumberOf Params . P5Error, ParamCount] , 

PSBDefs: FROM "p5bdefs". 

PeepholeDefs: FROM "peepholedef s" USING [JumpPeepState , PeepState], 

TableDefs: FROM "tabledefs" USING [TableNotif ier] , 

TreeDefs: FROM "treedefs" USING [treetype]; 

PeepholeU: PROGRAM 

IMPORTS CPtr: Code, OpTableDefs. PSADefs 

EXPORTS CodeDefs. PSBDefs, PeepholeDefs « 

PUBLIC BEGIN OPEN P5ADefs. OpCodeParams, CodeDefs, PeepholeDefs; 

-- imported definitions 

BYTE: TYPE = OpCodeParams .BYTE; 
qNOOP: BYTE = FOpCodes . qNOOP; 
CodeCCIndex: TYPE = CodeDefs .CodeCCIndex; 
JumpCCIndex: TYPE = CodeDefs .JumpCCIndex; 

cb: ChunkBase; -- code base (local copy) 

PeepholeUNotify: TableDefs .TableNotif ier « 

BEGIN -- called by allocator whenever table area is repacked 

cb ^ LOOPHOLE[base[TreeDefs. treetype]]; 

RETURN 

END; 

sourceindex: CARDINAL; 

SetSourcelndex: PROCEDURE [c: CARDINAL] « 
BEGIN sourceindex <- c END; 

GenReallnst: BOOLEAN; 

SetReallnst: PROCEDURE [b: BOOLEAN] = 
BEGIN GenReallnst <- b END; 

HalfByteLocal : PROCEDURE [c: CCIndex] RETURNS [BOOLEAN] « 
BEGIN 

IF c = CCNull THEN RETURN [FALSE]; 
WITH cb[c] SELECT FROM 

code => RETURN[inst = FOpCodes. qLL AND parameters[l] IN LocalHB]; 

ENDCASE => RETURN [FALSE] 
END; 

Loadlnst: PROCEDURE [c: CCIndex] RETURNS [BOOLEAN] « 
BEGIN OPEN FOpCodes; 
IF c = CCNull THEN RETURN[FALSE] ; 
WITH cb[c] SELECT FROM 

code => RETURN[~realinst AND (SELECT inst FROM 

qLI, qLL. qLG, qRIL, qRIG, qLADRB, qGADRB, qRR => TRUE. 
ENDCASE -> FALSE)]: 
ENDCASE => RETURN[FALSE] 
END; 

PackPair: PROCEDURE [l,r: [0..16)] RETURNS [w: WORD] « 
BEGIN OPEN InlineDefs; 
w <r BITSHIFT[1, 4]; 
w <- BITOR[w. BITAND[r. 17B]]; 
RETURN 
END; 

UnpackPair: PROCEDURE [w: WORD] RETURNS [l,r: [0,.16)] « 
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BEGIN OPEN imineDefs; 

1 ^ BITAND[BITSHIFT[w, -4], 17B]; 

r ^ BITAND[w, 17B]; 

RETURN 

END; 

UnpackFD: PROCEDURE [d: ControlDef s. FieldDescriptor] RETURNS [p,s: CARDINAL] 
BEGIN 

[posn: p, size: s] «- d; 
RETURN 
END; 

abccount, bccount, sllcount, sl2count: CARDINAL <- 0; 

InitParametersABC: PROCEDURE [p: POINTER TO PeepState] - 

BEGIN -- p.c is initialized and p.c # CCNull and cb[p. c] .cctag « code 

OPEN p; 

i: CARDINAL; 

abccount ♦- abccount+1; 
ainst ♦- binst <- cinst <- qNOOP; 
amin <- bmin ♦- cmin ^ FALSE; 
a ^ b <- CodeCCNuH ; 

IF -(GenReallnst OR -cb[c]. real inst) THEN RETURN; 
FininC[p]; 

IF (b«-LOOPHOLE[cb[c]. blink, CodeCCIndex]) = CCNull THEN RETURN; 
WITH cb[LOOPHOLE[b. CCIndex]] SELECT FROM 
code => 
IF GenReallnst OR -realinst THEN 
BEGIN 

binst <- inst; 
bmin ♦- minimalStack; 
bp <- [0.0,0]; 

FOR i IN [1. .ParaniCount[b]] DO bp[i] <- parameters[i] ENDLOOP; 
END; 
ENDCASE; 
IF (a<-LOOPHOLE[cb[b]. blink. CodeCCIndex]) = CCNull THEN RETURN; 
WITH cb[LOOPHOLE[a, CCIndex]] SELECT FROM 
code => 
IF GenReallnst OR -realinst THEN 
BEGIN 

ainst ^ inst; 
amin ♦- minimalStack; 
ap <- [0,0,0]; 

FOR i IN [1. .ParamCount[a]] DO ap[i] ^ parameters[i] ENDLOOP; 
END; 
ENDCASE; 
END; 

InitParametersBC: PROCEDURE [p: POINTER TO PeepState] » 

BEGIN -- p.c is initialized and p.c # CCNull and cb[p. c]. cctag » code 

OPEN p; 

i: CARDINAL; 

bccount <- bccount+1; 
ainst <- binst <- cinst <- qNOOP; 
amin ♦- bmin *- cmin <- FALSE; 
a ♦- b <- CodeCCNull ; 

IF -(GenReallnst OR '-cb[c]. real inst) THEN RETURN; 
FillInC[p]; 

IF (b^LOOPHOLE[cb[c]. blink, CodeCCIndex]) = CCNull THEN RETURN; 
WITH cb[LOOPHOLE[b, CCIndex]] SELECT FROM 
code => 
IF GenReallnst OR -realinst THEN 

BEGIN 

binst ^ inst; 

bmin <- minimalStack; 

bp ^ [0,0.0]; 

FOR i IN [t. .ParamCount[b]] DO bp[i] <- parameters[i] ENDLOOP; 

END; 
ENDCASE; 
END; 

InitParametersC: PROCEDURE [p: POINTER TO PeepState] » 

BEGIN — p.c is initialized and p.c # CCNull and cb[p . c] . cctag » code 
OPEN p; 
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ainst ♦" binst <- cinst *- qNOOP; 

amin ♦- bmin ^ cmin ^ FALSE; 

a ^ b ♦- CodeCCNull ; 

IF -(GenReallnst OR ~cb[c] . real inst) THEN RETURN; 

FminC[p]; 

END; 

CondFilllnC: PRIVATE PROCEDURE [p: POINTER TO PeepState] ■ 
BEGIN OPEN p; 

IF GenReallnst OR -cb[c] .real inst THEN FminC[p] 
ELSE 

BEGIN 

ainst ^ binst ^ cinst *- qNOOP; 

amin *- bmin <- cmin ^ FALSE; 

a ♦- b ^ CodeCCNull ; 

END; 
END; 

FilllnC: PRIVATE PROCEDURE [p: POINTER TO PeepState] » 

BEGIN -- p,c is initialized and p.c # CCNull and cb[p. c] .cctag » code 

OPEN p; 

i: CARDINAL; 

CPtr.codeptr ♦- c; 

sourceindex <- cb[c] .sourcef ileindex; 

cinst <- cb[c]. inst; 

cmin <- cb[c] .minimalStack; 

cp <- [0,0,0]; 

FOR i IN [1. .ParamCount[c]] DO cp[i] <- cb[c] . parameters[i] ENDLOOP; 

END; 

InitJParametersBC: PROCEDURE [p: POINTER TO JumpPeepState] « 

BEGIN -- p.c is initialized and p.c # CCNull and cb[p. c]. cctag ■ jump 

OPEN p; 

i: CARDINAL; 

binst <- cinst ♦- qNOOP; 
bmin *- cmin <- FALSE; 
b <r CodeCCNull ; 

IF (b^LOOPHOLE[cb[c]. blink, CodeCCIndex]) = CCNull THEN RETURN; 
WITH cb[LOOPHOLE[b. CCIndex]] SELECT FROM 
code => 
BEGIN 

bp *- [0,0,0]; 

IF -(GenReallnst OR '-cb[b]. real inst) THEN 
BEGIN 

binst ♦- qNOOP; 
bmin ^ FALSE; 
b <- CodeCCNull ; 
RETURN; 
END; 
binst *- inst; 
bmin <- minimalStack; 

FOR i IN [1. .ParamCount[b]] DO bp[i] <- parameters[i] ENDLOOP; 
END; 
ENDCASE; 
END; 

SlidePeepState2: PROCEDURE [p: POINTER TO PeepState. ci: CodeCCIndex] « 
BEGIN OPEN p; 
sl2count ^ sl2count+l; 

a <- b; amin <- bmin; ap <- bp; ainst ♦- binst; 
b *- c; bmin ^ cmin; bp ^ cp ; binst <- cinst; 
c ♦- ci; CondFillInC[p]; 
END; 

SlidePeepStatel: PROCEDURE [p: POINTER TO PeepState, ci: CodeCCIndex] » 
BEGIN OPEN p; 
sllcount <- sllcount+1; 

b <- c; bmin <- cmin; bp <~ cp; binst <- cinst; 
c <- ci; CondFillInC[p]; 
END; 

LoadConstant: PROCEDURE [c: WORD] « 
BEGIN 
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OPEN Mopcodes; 

ic: INTEGER; 

IF -GenReallnst THEN 

BEGIN Cl[FOpCocles.qLI. c]; RETURN END; 
ic <r LOOPHOLE[c]; 
SELECT ic FROM 

IN LoadlmmediateSlots «> CO[zLIn+ic]; 

-1 «> C0[zLINl3; 

IN BYTE «> Cl[zLIB, ic]; 

ENDCASE «> 

IF -ic IN BYTE THEN 

Cl[zLINB, In1ineDefs.BITAND[ic,377B]] 
ELSE ClW[zLIW, ic]; 
RETURN 
END; 

MCO: PROCEDURE [i: BYTE, minimal: BOOLEAN] ■ 
BEGIN -- outputs an parameter-less instruction 
c: CodeCCIndex; 

IF InstParamCount[i] i^ THEN P5ADef s .P5Error[961]; 

c <- PeepAllocCodeCCItem[i,0]; 

cb[c].inst ♦- i; 

cb[c] .minimalStack *- minimal; 

RETURN 

END; 



CO: PROCEDURE [i: BYTE] « 

BEGIN -- outputs an parameter-less instruction 
c: CodeCCIndex; 

IF InstParamCount[i] # THEN P5ADef s .P5ErrorC962] ; 

c ^ PeepAllocCodeCCItem[i,0]; 

cb[c].inst ♦- i ; 

RETURN 

END; 



CI: PROCEDURE [i: BYTE, pi: WORD] « 

BEGIN -- outputs a one-parameter instruction 
c: CodeCCIndex; 

c <- PeepAllocCodeCCItem[i,l]; 
cb[c].inst <- i; 
cb[c].parameters[l] <- pi; 
RETURN 
END; 



CIW: PROCEDURE [i: BYTE, pi: WORD] « 

BEGIN -- outputs a one-parameter( two-byte-param) instruction 
c: CodeCCIndex; 

c ^ PeepAllocCodeCCItem[i,2]; 

cb[c]. inst *- i ; 

cb[c].parameters[l] ♦- Inl ineDef s.BITSHIFT[pl. -8]; 

cb[c].parameters[2] ^ Inl ineDef s .BITAND[pl, 377B]; 

RETURN 

END; 



C2: PROCEDURE [i: BYTE, pi, p2: WORD] = 

BEGIN -- outputs a two-parameter instruction 
c: CodeCCIndex; 

c <- PeepAllocCodeCCItem[i.2]; 
cb[c] . inst ♦- i ; 
cb[c].parameters[l] ♦- pi; 
cb[c].parameters[2] ^ p2; 
RETURN 
END; 



C3: PROCEDURE [i: BYTE, pi. p2, p3: WORD] - 
BEGIN -- outputs a three-parameter instruction 
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c: CodeCCIndex; 

c ^ PeepA11ocCod6CCIt0m[i,3]; 
cb[c]. inst ♦- i ; 
cb[c].parameters[l] *- pi; 
cb[c].parameters[2] ♦- p2; 
cb[c] .parameters[3] ♦- p3; 
RETURN 
END; 

InstParamCount: PROCEDURE [i: BYTE] RETURNS [CARDINAL] - 
BEGIN 

RETURN[IF GenReallnst THEN OpTableDef s . inst1ength[i]-l ELSE NumberOfParams[i]] 
END; 

PeepAllocCodeCCItem: PROCEDURE [i: BYTE, n: [0..3]] RETURNS [c: CodeCCIndex] « 
BEGIN 

IF InstParamCount[i] ^ n THEN P5ADef s .P5Error[963]; 
c ^ AllocCodeCCItemfn]; 
cb[c] . real inst ^ GenReallnst; 
cb[c] .sourcef ileindex <- sourceindex; 
IF GenReallnst THEN 

BEGIN 

cb[c]. isize ^ n+1; 

cb[c]. aligned *- OpTableDef s. instal igned[i]; 

END; 
RETURN 
END; 

deleteZ: PROCEDURE [a,b: CCIndex] « 

BEGIN deletecell[a]; deletecell[b]; RETURN END; 

deletes: PROCEDURE [a,b,c: CCIndex] = 

BEGIN deletecellCa]; deletecell[b]: deletecel l[c]; RETURN END; 

END... 



